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FFF 000 000 RRR RRR RRR RRR TTT LLL 
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FFFFFFFFFFFF 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 
FFFFFFFFFFFE 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 
FFFFFFFFFFFF 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 

FFF 000 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR = =RRR TTT LLL 

FFF 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 
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FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLELLLLLLLLLL 
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FORSS$SI1GNAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 18.08 -Sep- 1384 90 :44:3) AX-11 Bliss-32 V4.0-7 Page 1 
14-Sep-1984 32:44 FORRTL.SRC FORSIGNAL. 4 2;1 (1) 

; 1 001 MODULE FORSSSIGNAL (%T aS ee SIGNAL, GNAL_STOP and $1G_NO_LUB' 

° ¢ 0099 0 IDENT = “1-007! ' File: ORs SIGNAL. ‘Bee Edit: 5801007 oa 2 

3 4 0004 1 BEGIN 

; 5 0005 1 

; 6 0006 1! 

3 4 sit 4 1 LE RRR RARER ERRATA REE ETEREREREA EEK RE EE 

3 1 Ie 

; 9 0009 1 !* COPYRIGHT (c) 1978, 1980, 1982, 1984 BY * 

; 0010 1 i* DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. * 

5 1) Bat] ! x ALL RIGHTS RESERVED. * 

Ps ; 2 

: i§ $018 1 '® THIS SOFTWARE 5 FURNISHED UNDER A LICENSE AND MAY BE USED AND gt la * 

; 1% 0014 1 !* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * 

. 0015 1 !* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS S$ R ANY OTHER * 

HY 16 0016 1 !* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * 

3 17 0017 1 !* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * 

: i sid : re TRANSFERRED. * 

° .* ® 

FH 20 0020 1 !* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * 

; 21 0021 1 !* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * 

; $$ it) } ‘* CORPORATION. * 

; ‘ff w 

; 24 0024 1 !* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR ee OF ITS * 

; 25 0025 1 !* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL * 

;- & 0026 1 !* * 

; if 0027 1 !« * 

M 28 0028 1 VRE RARER A RE EAAEEEAEREEAAAEEEEREEEKEEEE 

; a 0029 1! 

0030 1 

a 0031 1 !+4+ 

- oe 0032 1 ! FACILITY: FORTRAN Support Library 

;. = 0033 1! 

; 34 0034 1 ! ABSTRACT: 

a 0035 1! 

;: = bees 1! FORTRAN ouprer’ routines to convert FORTRAN error code 

> 037 1! to 32-bit VAX error code, and SIGNAL or SIGNAL_STOP 

; 3 4 : extra information in format compatible for SY SSPUT MESSAGE: 

: 60 0040 1 ! ENVIRONMENT: User Mode - AST re-entrant 

; 0041 1! Note: this module is both shared and non-shared. 

5 é€2 0042 1! If ge Hgts routine calls it, a non-shared copy is included. 

: ‘7 BRe7 ! Hence, JSB to FORSS$CB_GET instead of accessing OTS$SA_CUR_LUB directly. 

; a poe? ! AUTHOR: Thomas N. Hastings, CREATION DATE: 8=-Aug-1977 

4 47 0047 1 ! MODIFIED BY: 

: 48 0048 1! 

s 649 0049 1! Thomas N. Hastings, 8-Au god's VERSION 0 

; % 0050 1! Steven B. Lionel, VAX/VM .0 

; 0051 1 ! (Previous edit history removed. "$6 10-Nov-1980) 

3 2$ BR3¢ 1 | 1-001 = Update version number and toh.” Yes 08 notice, oe 16-NOV-78 

“Oh 0053 1! 1-306 - Change LUB$B_LUN to LUB$W_LU 

;s 3 bod 1 ! 1-003 - Chang e REQUIRE file names from hey to cots. AB 96, os -78 

; 3 055 1 | 1-004 = Get filename from FAB if all else fails. SBL 2 nugnh? 

; 2 0056 1 ! 1-005 - Add optional FAB argument to FORS$$SIG_NO_LUB. 3a -0CT-1979 

5 Ww 0057 1 ! 1-006 - Allow extra FAO arguments and conditions to be passed to 


E 


FORGES IGHAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 16- $e0-1984 99:45 :7] AX-11 Bliss-32 V4.0- 80. 4 Page as 


-Sep-1 :32:44 FORRTL.SRCJFORSIGNAL.B 
a J. As) * 5 aan STO. Remove debugging macros, no longer 


' 

i 

i wee First’ aoe bo edit *** 

i! 1-007 = Use prologue file. SBL 20-Jan-1983 
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5 tain FORTRAN SIGNAL, SIGNAL_STOP and S1G_NO_LUB 
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3 0 


“1984 00:44:51 YAX=11 Bliss-32_v4.0-74 Page 3 
1984 12:33:44 ERORRTLSRESFORSIGNAL 88251 ~~. 


PROLOGUE FILE: 


REQUIRE 'RTLIN:FORPROLOG'; 
! 


TABLE OF CONTENTS: 


FORS Definitions 


FORWARD ROUTINE 
ORSS$SIGNAL: NOVALUE 

FORSSS ION NAL_STO: NOVALUE, 

FORS$SIG_FATINT: NOVALUE, 


FORSS$SIG_DATCOR: NOVALUE, 
O_SIGNAL: NOVALUE, 


PORSssi S1G_NO_LUB: NOVALUE, 
COND_VALOE; 


tg #40 ons error code and LUB data 
2-bit error code and tua data 
NALS st e OTSS$_FATINTERR (FATAL 
a, RROR IN RUN-TIME LIBRAY) 
STOP OTS$_INTDATCOR CINTERNAL 
ATA At oRRY PTED IR RUN-TIME LIBRA 
Do the work a FOR S5S1GNAL IFORBSSIGNAL_ STO 
SIGNAL_STOP with no LUB se 
Return 32-bit condition Bs ti Poiven FORTRAN error # 


$I 
SIGN 
$I 
IN 
SIGN 
D 


i MACROS: 
: 
EQUATED SYMBOLS: 
LITERAL 
K_NO_FAO_SIGARG = 3; ! No. of FAO args in signal arg List 
! used by SYSSPUT_MESSAGE 
OWN STORAGE: 


NONE 


et tt SS SS SS SS SS SS SS SS OS SSS SS 2 OOOOO 


0 00 09 0D 09 SN NN DS DS DDD DD DS TT TUT BS BS BB BB BB NAINA NANO AAAO 


! EXTERNAL REFERENCES: 


ooo 


t 
!' MAINTENANCE NOTE: Since this module is called by FORTRAN compatibility 
! routines which are un-shared and the entry points are not vectored, 

! a separate copy of this module is Linked with the user program when 

' the user calls a FORTRAN compatibility routine. In order to prevent 

!' data truncation errors from the Linker, all external references are 

! of aseress tng. mode general (rather than word displacement) even for 

the same PSECT 


cise ROUTINE 
ORS$SCB_GET: jm. CB_GET NOVALUE ADDRESSING oy B i ventas ' Set CCB to adr. of current LUB/I1SB 
FORSSERRSNS. S “NOVALUE A ADORE SSING MODE (GEN Save error info for FORSERRSNS. 
LIBSSIGNAL: -pOVALUE ADDRESSING MODE TGENERA 4 At Sreum. error and continue 
LIBSSTOP: NOVALUE ADDRESSING NAODE (GENERAL) ¢ i SIGNAL error and STOP 


FWD OOD NAUES WN 3S ODNA UE WIN SO OONA UE WN 9 OOD NOAUE WN SC ODNAUESWNOUE WW 
abuiatababubabatabababubabmbabababababaimabuabataiwiuaabaAaiatmiuiabababmiahababababababuababa ad abababadueicaadiand 
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FORSSSIGNAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 16-Sep-1 94 00 :35:3) AX-11 Bliss-32 v4 Page 4 
1-007 14-Sep-1984 12:32:44 FORRTL.SRC FORSYGNAL. 8 2;1 (2) 
8 
8 


5 1 EXTERNAL LITERAL 
138 : : OTSS_FATINTERR: UNSIGNED (%BPVAL), ! Condition value FATAL INTERNAL ERROR IN RUN-TIME LIBRARY 
8 1 


1 Q 
2 ) 
15a : OTS$_INTDATCOR: UNSIGNED (%BPVAL); ! Condition value INTERNAL DATA CORRUPTED IN RUN-TIME LIBRAR 


1 
1 
1 
1 


16 
1b-Se 1984 00:44:51 AX=-11 Bliss=-32 V4.0-74 P 
17385-1984 12:32:44 FORRTL.SRCJFORSIGNAL .B52;1 tee ( 


GLOBAL ROUTINE FORSSSIGNAL ' SIGNAL FORTRAN error and continue 
:NOVALUE = !' No value returned. 


= FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 


1o4 


! FUNCTIONAL DESCRIPTION: 


: Signals a FORTRAN=-specific error whose 32-bit condition code or 

: small-integer error number is the first argument. If other arguments 
: are present, they represent extra FAO arguments for the first 

: condition and/or secondary conditions to be signalled. See DO_SIGNAL 
for more information 
' 
' 
+ 
i] 


i CALLING SEQUENCE: 


CALL FORSSSIGNAL (fort_err_no.rc.v C,fao_args_0.rz.v, ...] 
,secondary_msg.rc.v Cisec_fao_cnt.rl.vl, sec_fao_args.rz.v,...J) 


! FORMAL PARAMETERS: 


fort_err_no - A 32-bit FORS code or the small integer which is the 
error number part of a FORS code. 
fao_args_0 - FAO arguments for this message. The three FAO arguments 


unit number, filename and user PC are always used; if 
fao_args_0 are specified, they come before the default 


arguments. 
secondary_msg - Setendery message to be signalled. MUST be a 32-bit code. 
sec_fao_cnt - FAO count for secondary message 


1 

{ 

1 

! 

1 

' 

' 

1 

1 

' 

sec_fao_args - FAO arguments for secondary message 
; IMPLICIT INPUTS: 
See DO_SIGNAL 
IMPLICIT OUTPUTS: 

; See DO_SIGNAL 
COMPLETION CODES: 

! NONE 

SIDE EFFECTS: 

! 
1 
1 


MEUM =O ODNOUS WN SO ODNAUES WN —OODNAULSWNOODNDS 


DO_SIGNAL (.AP, LIBSSIGNAL); 
RETURN 
END; 


SHE EWWIAWIWIIWIIWIAID RI NININININININID 2 2 2 SS SS 2 QOCDTOOCOCOCOOOOOOOOOOOCR 
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7 

8 Converts FORTRAN error code to 32-bit VAX-11 error code and SIGNALs. 
H Saves error info in FORSERRSNS OWN storage. 
1 

g BEGIN 

4 BUILTIN 

5 AP; 

6 

7 

8 

9 

0 


FORSSSIGNAL 
1-007 


; Routine Size: 


FORTRAN SIGNAL, SIGNAL_STOP and $IG_NO_LUB 


16 bytes, 


0000v CF 


Routine Base: 


0000 

000000006 90 oF 
C OD 

02 FB 

04 


_FORSCODE + 0000 


251 AX-11 Bliss-32 V4.0-74 
244 FORRTL. SRCJFORSIGNAL. 832;1 


Page 


6 
(3) 


FORSS$SIGNAL e-Yr SIGNAL, SIGNAL_STOP and SIG 


-NO_ 
\1-007\ 
FORSSCB GET, FORSSERRSNS_ SAV 
LIBSSIGRAL STOP 
OTS$_ PRTINTERR’ OTS$_INTDATCOR 
_FORSCODE,NOWRT, SHR, PIC,2 


4 ity tient Save nothing 
LIBSSIGNA 


AP 
#2, DO_SIGNAL 


K 16 
FORSSSIGNAL FORTRAN SIGNAL, SIGNAL_STOP and S$IG_NO_LUB 16-Sep-1984 00:44:51 AX-11 BL i $$-32 V4 
1-007 12-Sep-1984 32:44 FORRTL.SRCJF FORs Yelle. y 2:1 
; \8¢ 0244 1 GLOBAL ROUTINE FORSSSIGNAL_STO ! SIGNAL_STOP FORTRAN error and STOP 
s 118 8 | :NOVALUE = i No value returned. 
> «6186 6 1 +4 
$ 13? 0 ts : FUNCTIONAL DESCRIPTION: 
: 189 § 49 1! Convert FORTRAN error code number to 32-bit VAX-11 se code. 
; «4188 0250 1! See description for FORSS$SIGNAL above which is identica 
; 189 0 2 except that FORSS$SIGNAL_STO aoe CIBSSTOP instead. of CPIOSSIGNAL. 
3; «6191 0 2g 1 
3 135 0254 BEGIN 
: 19 8 2? 
3 194 6 BUILTIN 
3; 6195 0257 AP; 
; 196 0 28 
; 197 025 DO_SIGNAL (.AP, LIBSSTOP); 
; 198 0260 
3; «6199 0261 2 RETURN 
: 200 0262 1 END; 
0000 00000 ENTRY FORSS$SIGNAL_STO, Save nothing 
00000000G 00 O9F BR bas PUSHAB LIBS$STOP 
5C DD 0000 PUSHL AP 
0000v CF 02 FB OOOOA CALLS #2, DO_SIGNAL 
04 0000F RET 


; Routine Size: 16 bytes, Routine Base: _FORSCODE + 0010 


Page 
7 (4 


7 
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FORS$SIGNAL FORTRAN SIGNAL, SIGNAL_STOP and S1G_NO_LUB 18-56 Sep-1984 4:5] AX=-11 Bliss-32 V4.0 
150? 3b-198¢ 93: $3: 744 FORRTL. SRC FORSIGNAL. 3 231 


: oe 8 3 1 GLOBAL ROUTINE FORSSSIG _FATINT ! SIGNAL_STOP OTSS_FATINTERR and STOP 
; 20 4 1 LUE = ! No value returned. 
; 204 8 65 1 !4+ 
; 32 8 ¢ } FUNCTIONAL DESCRIPTION: 
: 07 0268 1! — STOP OTSS$_FATINTERR = FATAL INTERNAL ERROR IN RUN-TIME LIBRARY. 
; 208 0 4 1! Note: the current LuB (if any) is ignored and no UNIT is printed. 
MRR YI 
> 211 0 2 BEGIN 
; 1 027 FORSS$SIG_NO_LUB (OTSS$_FATINTERR); 
5s a bsfe RETURN 
3 214 0275 1 END; 
0000 00000 ENTRY FORSS$SIG_FATINT, Save nothing 
00000000G 8F dD 00002 PUSHL #OTS$_FATINTERR 
0000v CF 01 FB 00008 CALLS #1, PORSSS1G _NO_LUB 
04 00000 RET 


; Routine Size: 14 bytes, Routine Base: _FORSCODE + 0020 


Page 
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; Routine Size: 14 bytes, 


FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 16- se0-1984 09:44:5] AX-11 Bliss-32 V4.0 


-Sep-1 232:44 FORRTL.SRC FORSIGNAL. 5 2:1 
GLOBAL ROUTINE FORS$SIG_DATCOR ! SIGNAL_STOP OTSS$_ INTDATCOR and STOP 
:NOVALUE = ' No value returned. 


; FUNCTIONAL DESCRIPTION: 


SIGNAL_STOP OTSS cyte 


INTERNAL DATA CORRUPTED IN RUN-TIME LIBRARY. 
Note: the current LUB ( ) 


ny is ignored and no UNIT is printed. 


BEGIN 
FORS$$SIG_NO_LUB (OTS$_INTDATCOR); 
RETURN 


0000 00000 -ENTRY FORS$SIG_DATCOR, Save nothing 
00000000G 8F DD 00002 PUSHL sors INTDATCOR 
0000v CF 01 FB 00008 CALLS , FORS$SIG_NO_LUB 
04 0000D RET 


Routine Base: _FORSCODE + 002E 


Page 


9 
(6) 


0276 
0286 


0288 


18 1 
FORS$S1GNAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB p-$00° 138% 744:51 AX-11 Bi ise -32 V4.0-7 Page 1 
1-007 4-Sep-1984 12:32:44 FORRTL. §Re] FORSIGNAL. : 2;1 (7 


Internal routine i“ do work for FORSS$SIGNAL and FORS$SIGNAL_STO 
List of arguments to signal routine 

' adr. of LIBSSIGNAL or LIBS$STOP 

! No value returned 


ROUTINE DO SIGNAL ( ! 
SIGNAL_LIST_ARG, ' 
SIGNAL ROUTINE) ' 
: NOVACUE = ! 
++ 


FUNCTIONAL DESCRIPTION: 


Converts error code number to 32-bit VAX-11 error code. 
See description of FORSS$SIGNAL above. 


! FORMAL PARAMETERS: 
SIGNAL_LIST_ARG f AP at time of call to FORSSSIGNAL or 
SIGNAL _ROUTINE BSSIGNAL or LIBSSTOP | 
IMPLICIT INPUTS: 
OTS$$A_CUR_LUB Adr. of current LUB/ISB/RAB 


Obtained by JSB to FORSSCB_GET. ; 

{FAB,RAB}$L_STS RMS error status 3 
i IMPLICIT OUTPUTS: | i | 
{FAB ,RAB}S$L_STS oa error status - set to 0 | 3 
{FAB,RAB}$L_STV RMS error value or operating system error code - set to 0 | 
FORTRAN error , RMS STS, RMS STV, logical unit number saved in st 
OwN storage fn hs fae module for Later : | 


call by user to ERRSNS 
COMPLETION CODES: 
NONE 
SIDE EFFECTS: 


Converts FORTRAN error code to 32-bit VAX-11 error code and SIGNALS. 
Saves error info in FORSERRSNS OWN storage. 


SPE Ree any we eee | 
FUN — CO OODNAOU EWN 0 OBNOUS WN -O0O@ Vilwwn—Oo 


' 
i 
i 
i 
i 
i 
i 
' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
{FAB,RABS$SL_STV RMS error value or operating system error code 
i 
! 
i 
' 
' 
i 
' 
i 
i 
i 
i 
i 
i 
i 
i 
i 
he 
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SIGNAL 
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1 
FORTRAN SIGNAL, SIGNAL_STOP and S1G_NO_LUB 16-Sep-1984 00:44:51 AX-11 Bliss=32 v4.0-74 Page 1 
14-Sep-1984 12:32:44 FORRTL.SRCJFORSIGNAL.B32;1 (8 
BEGIN 
GLOBAL REGISTER 
CCB = K_CCB_REG: REF $FORSCCB_DECL; 
LOCA 


L 
FILE_NAME_DSC: DSCSDESCRIPTOR, ! File name descriptor for resultant file name 
RABORFAB: REF BLOCKL, BYTE], 
STS RMS RAB or FAB error status 


RMS RAB or FAB error status 

Returned values from $GETMSG 
prqusent List to LIB$SIGNAL/LIB$STOP 
Pointer into signal List 

pointer into SIGNAL_LIST_ARG 

Address of argument list end 

32-bit VAX-11 error code 


STV. 

GETMSG_VALS: VECTOR (4, BYTE] 
SIGNAL“LIST: VECTOR (26, LoNGd, 
LIST PTR: REF VECTOR CL, LONG], 


ARGS"PTR: REF VECTOR C, LONG. 
ARG_CIST_END, 
CONB_VAL? BLOCK (4,BYTE); 

MAP 


SIGNAL_LIST_ARG: REF VECTOR C, LONG]; 
BUILTIN 
CALLG; 
FORSSCB_GET (); ! Set CCB to adr. of current LUB/ISB/RAB 


o 
Convert FORTRAN error code to 32-bit VAX-11 error code. 
Conversion is done by copying FORTRAN error number to code field, 
setting the severity code to SEVERE, 
for all errors except FORS$_OUTCONERR (63="OUTPUT CONVERSION ERROR") 
which is set to ERROR instead so that image will continue 
Y default since output field is flagged with ***s. 
ALL other continuable errors are signaled SEVERE so that user 
must take overt action in order to continue past the error. 
bes ting the facility code to FORSK_FAC_NO, 
and setting the facility specific Bit TSTS$V_FAC_SP). 


COND_VAL = COND_VALUE (.SIGNAL_LIST_ARG (1]); 
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7 '+ 

33 Call SGETMSG to see how many FAO parameters it takes. 
7 

7 BEGIN 

37 LOCAL 

Hi DSC: VECTOR (C2, LONG), 

37 DSC } = 0; ! Null string descriptor 
37 DSC C1J = LEN; 

38 $GETMSG ( 

38 MSGID = .COND_VAL, 

38 GLEN = LEN, 

38 BUFADR = DSC, 

38 FLAGS = 0, 

38 OUTADR = GETMSG_VALS); 

38 END; 


a 
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AX=11 Bliss-32 V4.0 


'+ 
Compute total number of signal arguments. 


SIGNAL_LIST CO] = (,.SIGNAL_LIST_ARG [0])<0,8,0> + 6; 

ARG_LIST_END = SIGNAL_LIST “ERG TO] + ((.SIGNAL_LISTARG [0J)<0,8,0> * %UPVAL); 
'¢ 

} Fill in primary condition message. 

SIGNAL_LIST f3 = ,COND_YAl; 

SIGNAL“LIST [2] = .GETMSG_ vats C1]; ! Number of FAO parameters 

LIST_PTR = SIGNAL_LIST (3); 

ARGS_PTR = SIGNAL_LIST_ARG (2); 


'¢ 
x Copy extra FAO arguments, if any. 


INCR I FROM 4 TO .SIGNAL_LIST C2] DO 
COPY_LONG_A (ARGS PTR, LIST_PTR); 


'¢ 

i Get RMS error status from RAB or if not error there from FAB (if any). 

i Then set error status Longwords to 0 so will not be found again. 

i Note: this code depends on the fact that FABSL_STS/STV have the same offsets 
: _as RABSL_STS/STV. 


. . 0; ' Set initial values 
IF CCB CLUBSW_LUN NEQU LUBSK_LUN_ENCD ' Not ENCODE/DECODE/internal? 
eceie as 


RABORFAB = .CCB; 
IF (. CCBCRABSL 57S] OR .CCBCRABSL_STS] EQL 0) 


RABORFAB = .CCBCRABSL_FAB); 
IF NOT .RABORFABCRABSL_STSJ 
THEN 


BEG! 
STS = .RABORFABCRABSL_STS]; 
STV = .RABORFAB RABSL~ STV; 
END; 

RABORF ABCRABS$L_STS] s 8: 


pha RABSL-STVJ 


'¢ 
: Save FORTRAN error number, RMS STS, RMS STV, logical unit number and VAX-11 condition value 


FORRTL.SRC FORSIGNAL. 3 2;1 
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; a6 pate FORSSERRSNS_SAV (.COND_VAL CSTS$V_CODE], .STS, .STV, .CCBCLUB$W_LUNJ, .COND_VAL); 
(3; 588 Daeg 4 
; 389 044 i Set up resultant file name descr ptor that pete put in signal arg list. 
3 4 Bees 1. Note that this points at the FAB's FNM until the file is opene 
; 0450 
is ay 0451 FILE_NAME_DSCCDSCSW_LENGTH) = .CCBCLUB$B_RSLJ 
: 394 Be 2g FILE_NAME_DSCLDSCSB_DTYPE] = FILE NAME _OSCCDS s¢$B_CLAss] = 0; 
;. 39 045 FILE_NAME_DSCCDSCSA_POINTER] = 
; 396 0454 T IF TCCBCLUBSB-RSLJ EQLU 0 
3 97 0455 THEN 
; #398 0456 0 
; 399 0457 3 ELSE 
; 400 0458 5 . CCBCLUB$A_RSNJ); 
: 401 0459 
: 40 0460 2 + 
; 40 0461 2 ! Insert the three default FAO arguments plus the STS and STV. 
; 4046 Reet 2 le 
; 405 0465 2 
; 406 0464 LIST_PTR CO} = .CCB CLUBSW yes 
; 407 0465 LISTIPTR (1) = FILE_NAME_ 
; 408 0466 é LIST PTR ¢] = 0; ! For user PC 
: 409 0467 LIST=PTR [3] = .STS; 
: 410 0468 2 LIST_PTR (4) = .STV; 
; «64411 0469 2 LIST_PTR = LIST PTR’ (5); 
; ey 0470 2 
: #61 0471 2 WHILE .ARGS_ PTR LEQ .ARG_LIST_END DO 
3; 416 0472 2 COPY_LONG_A (ARGS_PTR, LIST_PTR); 
3 415 0473 2 
; 416 0474 2 + 
: 4617 0475 2 ' Call LIBSSTOP to STOP the error or LIBSSIGNAL to SIGNAL the error. 
> 418 0476 2 = 
3 419 0477 2 
; $20 0478 2 CALLG (SIGNAL_LIST, .SIGNAL_ROUTINE); 
: 421 0479 2 
: 422 0480 2 ‘+ 
3; 423 0481 2 ' Return 
: 626 0482 2 l- 
: 425 0483 2 
; 426 0484 2 RETURN ; 
: 427 0485 1 END; ! End of FORS$SIGNAL_STO routine 
-EXTRN SYSSGETMSG 
O8FC 00000 DO_SIGAL: 
«WORD Save R2,R3,R4,R5,R6,R7,R11 ; 0289. 
5€ 98 AE 9E 00002 MOVAB =104(SPS, SP : 
000000006 00 16 BR ane JSB FORS$CB_GET : 0353 
52 04 aC 00 0000C MOVL SIGNAL_CIST_ARG, R2 ; 0368 
04 A2 OD B0019 PUSHL ashe) 3 
0000v gf 01 FB 0001 CALLS P coe VALUE : 
4 50 dO 00018 MOVL RO COND~ VAL F 
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; Routine Size: 
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sep-1984 99:44:5) 
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FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB | 


$SIGNAL 


FORS 
1-00 


~~ 


Be Se Se Se Se Se Se Se Se Be Se Se He Se Se Oe He Oe Oe Oe SH Oe Oe Oe Oe we Be Oe Se Oe Oe Oe Oe Oe BH Oe Oe Oe OH Se BH Oe Oe Oe Oe Oe Oe os 


H 1 
ORS$S1GNAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB Jo~senn 1386 90 :45:3) eet Bliss-32 V4.0-74 Page 16 
-007 14-Sep-1984 12:32:44 FORRTL.SRCJFORSIGNAL.B52;1 (9) 
429 04 § 1 GLOBAL ROUTINE FORSS$SIG_NO_LUB ( ! SIGNAL_STOP FORTRAN gsror and STOP 
430 4 1 FORT_ERR_NO, ! FORTRAN error Code 0:120 or 32-bit cond value 
431 488 1 ! VAX=11 error code 
4 § 0489 1 FORT_LUN, ! Optional FORTRAN Logical unit number 
4 0490 1 FAB) ! Optional FAB address 
434 0491 «1 :NOVALUE = ! No value returned. 
435 0492 1 !++ 
. ote ! FUNCTIONAL DESCRIPTION: 
13 0495 1! Convert FORTRAN error code number to 32-bit VAX-11 error code. 
439 0496 1! The following SIGNAL_STOP arguments are obtained from the 
440 ont 1! argument List only since no LUB/ISB/RAB yet: 
44) 496 1! 
44 0499 1! VAX-11 error code: 
44 0500 1! STS$V_SEVERITY = STSS$K_SEVERE 
444 0501 1! STS$V_CODE = FORTRAN error number | 
445 b206 1! STS$V_FAC_SP = 1 (facility specific error messenes 
446 0505 1 } STS$V_FAC_NO = FORTRAN facility no. (FORSK_FAC_NO) 
447 0504 1! 3 = No. of following FAO arguments 
448 0505 1! FORTRAN unit number if present or zero 
449 0506 1! File name string descriptor address or 0 if no FAB 
450 0507 1! User PC of call to library (set to 0 here, rewritten by handler before RESIGNAL) 
451 0508 1! RMS error code from FAB if present 
$e 5394 ! System error code from FAB if present 
rer: Bett : FORMAL PARAMETERS: 
456 0818 1 } FORT_ERR_NO.rlu.v FORTRAN error code (0:120) or 32-bit cond value 
457 0514 1! 32-bit VAX-11 error code with LH already set. 
458 0515 1! CFORT_LUN.rlu.vJ Optional unit number, 0 used if not present 
459 0516 1! CFAB.rbu.ra] Address of FAB if present 
460 0517 1! 
461 0518 1 ! IMPLICIT INPUTS: 
46 0519 1! | 
46 0520 1! NONE 
464 0521 1! 
465 8256 1 ! IMPLICIT OUTPUTS: 
466 0525 3 ! 
467 0524 1! NONE 
468 O5e9 1! 
469 0526 1 ! COMPLETION CODES: 
470 0527 1! 
471 0528 1! NONE 
47 0269 1! 
47 0530 1 ! SIDE EFFECTS: 
474 0557 7 ! s 
rit} b255 : ; Converts FORTRAN error code to 32-bit VAX-11 error code and SIGNAL_STOPs. 


—wn 
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'¢ | 
' Save FORTRAN error #, RMS STS, RMS STV, Logical unit number, and VAX-11 condition value. 
If FCRT_LUN not present, use 6 (e.g., INVALID ARG TO FORTRAN 1/0 SYSTEM) 


FORSSERRSNS_SAV ( pony 


a NO, .STS 
(IF ACTOALCOUNT 1 


_ERR , hte; | 
GTRO 1 THEN .FORT_LUN ELSE 0), .VAX_11_COND_VAL); 
'¢ 

Set up file name descriptor 
NAME_DSC (DSC$B_CLASS 


NAME~DSC CDSC$B~DTYPE) = DSCSK~ . 
ff ACTUAL COUNT T™) GTRU 2 


BEGIN 
IF .FAB CFABSL_NAM) NEQ 0 
THEN 
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1 | 
RS$$S1GNAL FORTRAN SIGNAL, SIGNAL_STOP and S1G_NO_LUB 18-Sep-1984 90:45:3] AX-11 Oh iegere V4.0-74 Page 17. 
007 14-Sep-1984 32:44 FORRTL.SRCJFORSIGNAL.B52;1 (10) | 
478 534 BEGIN 
479 535 CAL 
re 4 5 $ VAX_11_COND VAL: BLOCK(4,BYTE], ! serie VAX-11 error code 
481 5 NAME_DSC : DBSCSDESCRIPTOR, i File name descriptor 
rt 0538 STS, ' RMS error status 
48 0539 TV; ! System error status 
484 0540 P 
485 0541 FORT_ERR_NO: BLOEKE eries, ! MAKE 32-bit VAX-11 error code 
486 R266 FAB = REF BLOCK C,BYTEI; ! FAB is address of FAB 
487 54 BUILTIN 
488 544 ACTUALCOUNT; ! Actual no. of parameters 
489 545 
490 278 i+ 
491 054 ! Convert FORTRAN error code to 32-bit VAX-11 error code unless 
49 0548 ! already converted by the caller. Conversion is done 
49 0549 ' by copying FORTRAN error number to code field, 
494 0550 ' setting the severity code to SEVERE 
495 0551 i setting the facility code to FORSK FAC_NO 
496 0326 i and setting the facility specific Bit CSTS$V_FAC_SP). 
497 055 l- 
498 0554 
499 0555 VAX_11_COND_VAL = COND_VALUE (.FORT_ERR_NO); 
500 0556 
501 0557 + ; 
502 0558 ' If FAB argument is present, retrieve RMS and SYSTEM error codes. 
503 0559 '- 
04 0560 
05 0561 IF ACTUALCOUNT () GTRU 2 
9206 THEN 
056 BEGIN 
0564 STS = (IF .FAB CFABSL_STS] THEN O ELSE .FAB CFAB$L_STS)); 
0565 STV = (IF .FAB CFABSL_STVJ THEN O ELSE .FAB CFABSL_STVJ); 
0566 END 
0567 E 
0568 BEGIN 
0569 STS = 0; 
0570 STv = 0; 
0571 END; 
B26 
057 
0574 
0575 
0576 
0577 
0578 
0579 
0580 
0581 
b28¢ 
058 
0584 
0585 
0586 
0587 
b2e6 
589 
0590 
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OR$$SIGNAL FORTRAN SIGNAL, SIGNAL_STOP and $1G_NO_LUB 16-Sep-1984 09:44:51 AX-11 Bliss-32 V4.0-74 
-007 14-Sep-1984 12:32:44 FORRTL.SRCJFORSIGNAL.B352;1 
5 0591 4 BEGIN 
B208 4 LOCAL 
595 4 NAM : a 2 BLOCK C,B8YTE); ! NAM block 
538 0594 4 NAM = .FAB CFABSL_NAMI; 
539 0595 4 IF .NAM CNAM$B_RSC) NEQ 0 
ery 8238 4 THEN 

4) 0597 5 BEGIN 
e¢g 0598 5 NAME _DSC THthre steady: = .NAM CNAM$B_RSL]; 
az 5444 : renee DSCSA_POINTER] = .NAM CNAMSC_RSAJ; 

545 0601 4 ELSE IF .NAM CNAM$B_ESL] NEQ 0 

ee8 0602 4 THEN 

54 0605 5 EGIN 

548 0604 5 NAME_DSC CDSCSW_LENGTH] = .NAM CNAM$B_ESLJ; 
549 0605 5 NAME-DSC CDSCSA-POINTER] = .NAM CNAMSC_ESAJ; 
550 0606 5 ND 

551 0607 4 

226 0608 5 BEGIN 

55 0609 5 NAME _DSC Hire yeah: = .FAB CFABSB_FNS); 
554 0610 5 NAME-DSC CDSCSA_POINTER] = .FAB CFABSC_FNAJ; 
555 0611 4 END; 

556 0612 4 END 

557 0613 3 

558 0614 4 BEGIN 

559 0615 4 NAME _DSC Habre sti: = .FAB CFABSB_FNS); 

560 3616 4 NAME-DSC CDSC$ATPOINTER] = .FAB CFABSC_FNAI; 

561 617 3 : 

206 0618 3 END 

56 0619 E 

564 0620 BEGI 

565 0621 NAME _DSC CDSCSW_LENGTH] = 0; 

566 062¢ y NAME-DSC CDSCSA~POINTER] = 0; 

567 0623 2 ; 

568 0624 2 

569 0625 2 '¢ 

570 0626 2 ! Call LIBSSTOP to SIGNAL_STOP the error $ 
3) 434 § Order of args is same as defined in FPAR.MDL for use with SYSSPUT_MESSAGE 
375 0629 § 

574 0630 LIBSSTOP ( ; 

575 0631 2 -VAX_11_COND_VAL, ! 32-bit VAX-11 error code 
576 063 K_NO-FAO_SIGARG, ! no. of $AO arguments following in FORTRAN error message 
877 063 -FORT_LUR, ! FORTRAN Logical unit number 
278 0634 NAME _BSC, ' File name descriptor ; 

79 0635 ‘ ' Leave room for user PC to be filled in 
580 0636 ' by FORTRAN specific handler established on user call 
581 0637 -STS ' RAS error code 
382 0638 -STV); i SYSTEM error code 
58 0639 
584 0640 '¢ 
585 0641 ' Return 
586 064 le 
587 064 
588 0644 RETURN 
589 0645 1 END; ! End of FOR$$SIG_NO_LUB routine 
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“FORSSS LGNAL FORTRAN SIGNAL, SIGNAL_STOP and S$1G_NO_LUB Ib-5e 00-1382 99: 43:3) cette ath ate i 4 Page 460 
3 DD A PUSHL #3 ; 0630 
| DD A PUSHL yo. 11_ COND VAL ; 0631 

000000006 00 FB A CALLS LIBSSTOP : 
| 04 RET ; 0645 
| 4 
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SIGNAL, SIGNAL_STOP and SIG_NO_LUB 16-Sep-1984 00:44:51 AX-11 Bliss-32 V4.0-74 Page 21 
122360718 4 99:93:44 FORRTL.SRCIJFORSIGNAL .852;1 ° af 
ROUTINE COND_VALUE ( ! Internal roe to convert from FORTRAN error # 
! to VAX-11 condition value 
FORT_ERR_NO) ' Value of FORTRAN error # (0:120) or 32-bit cond value 
= ! Value is 32-bit VAX-11 condition value 


lee 
! FUNCTIONAL DESCRIPTION: 
Converts from FORTRAN error number to 32-bit VAX=-11 condition value 
complete with groper severity and all other fields set. 
If already a 32-bit sondition value (ie GIRU FORSK_ERR_MAX), 
no converions is done. Instead the FORTRAN error # is” FORSK_NOTFORSPE 
which has a value of 1 and indicates a non-FORTRAN specific error. 
FORMAL PARAMETERS: 
FORT_ERR_NO ! Value of FORTRAN error # (0:120) or 32-bit cond value 
IMPLICIT INPUTS: 
NONE 
IMPLICIT OUTPUTS: 
NONE 


ROUTINE VALUE: 
COMPLETION CODES: 


32-bit VAX-11 condition value. 
SIDE EFFECTS: 


NONE 

BEGIN 

sang Ot RI BLOCK (4, BYTE); ! Could be a condition value 
VAX_11_COND_VAL: BLOCK (4, BYTE]; ! 32-bit VAX-11 error condition value 


Convert FORTRAN error code to 32-bit VAX-11 error code, unless already 

a 32-bit condition value (some other facility than FOR$ in LH). 

Conversion is done by copying FORTRAN error number to code field, 

setting the severity code to SEVERE, except error 63 (OUTPUT CONVERIOSN ERROR) 
in which case the severity is set to ERROR. 

Thus the user must do something oupi test in order to continue 

for all errors, except 63 (but it has ***s so error {i agped? « Bs fa 
Therefore the user will not tnedveransty use data which had errors in it. 
potting the eects ity code to FORS$K FAC_NO 

and setting the facility specific Bit TSTS$V_FAC_SP). 


IF .FORT_ERR_NO LEQU FORSK_MAX_ERR 
THEN 
BEGIN 


if. 5. | 
FORSSS1GNA FORTRAN SIGNAL, SIGNAL_STOP and N -1 Ax-11 B 4.0-74 
Ret, IGNAL a and SIG_NO_LUB _ 384 99: $833 ei} s$° -32 V4.0 Page 8 


-Sep-1 FORRTL. FORSIGNAL.B32;1 
; 8 703 3 VAX_11_COND_V 
; 649 , : 4 VAX~11—COND “Vat est sév SEVERITY] = (IF .FORT_ERR_NO EQL FORSK_OUTCONERR 
; bef 7 6 4 STS$K_ERROR 
; 6 ; 7 4 ELSE 
; 6 7 3 prsen., SEVERE); 
; 654 7 VAX_11_COND_VAL[STS$V_CODE] = .FORT_ERR_N 
; 655 710 VAX~11—COND~ VAL STS$V-FAC_SP] = 
; 656 711 VAX-11-COND-VALCSTS$V_FAC-NOJ = rhage 
; 657 Brie END™ 
; 658 71 ELSE 
: 659 714 VAX_11_COND_VAL = .FORT_ERR_NO; 
; 660 715 
; 661 0716 RETURN .VAX_11_COND_VAL 
; 662 0717 1 END; ! End of COND_VALUE routine 
0000 00000 COND_VALUE: 
«WORD Save nothing ; 0646 | 
0000005D = &F 04 AC D1 00002 CMPL FORT_ERR_NO, #93 ; 0700 
27 1A OOOOA BGTRU 3$ ; 
51 D4 0000C CLRL VAX 11_COND_VAL + 0703 
3F 04 AC D1 OOO0E CMPL FORT_ERR_NO, #63 3 0704 
05 12 00012 BNEQ 1$ ; 
50 0 DO 00014 MOVL #2, RO : 
03 11 00017 BRB 2s ; 
50 04 DO 00019 1$: MOVL RO ; 
51 03 00 50 FO O001C 2$: INSV RO. #0, #3, vay 11_COND_VAL : 
51 0c 03 04 AC FO 00021 INSV. _ FORT_ERR NO. Te. VAX_11_COND_VAL : 0709 
51 8000 8F A8 00027 BISw2 #32788 VAX ND_VAL : 0710 
51 0c 10 18 FO b00¢¢ INSV , #16, aT2 “VAN T1_COND_VAL : 0711 
04 11 00031 BRB ; 0700 
51 04 AC DO 00033 3$: MOVL PORT ERR_NO, VAX_11_COND_VAL ; 0714) 
50 51 DO 00037 4$: MOVL VAX_T1 _COND. VAL, RO™ ; 0716) 
04 0003A RET ; 0717, 
; Routine Size: 59 bytes, | Routine Base: _FORSCODE + 01(2 


' End of module 
664 


PSECT SUMMARY 
Name Bytes Attributes 
_F ORSCODE 509 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 


ee Se ee 


FORSSSIGNAL FORTRAN SIGNAL, SIGNAL_STOP and SIG_NO_LUB 16-Sep-1984 00:44:51 VAX=-11 Bliss-32 V4.0-742 Page 23 
1-007 14-Sep-1984 12:32:44 CFORRTL.SRCIFORSIGNAL.B32;1 (11) | 
H Library Statistics 

; , onaonens Symbols “ooeee=> Pages Processing 

; riie Total Loaded Percent Mapped Time 

! _$255$DUA28:(SYSLIBISTARLET.L32;1 9776 27 0 581 00:01.0 

> ~$255$DUA28: bonnie pedal ort ie-beess 711 186 26 52 00:00.6 

> _$255$DUA28:CFORRTL.OBJIRTLLIB.L32;1 36 0 0 8 00:00.1 


COMMAND QUALIFIERS 
Spetairensenh stipe tg cae capechtaant thal cae idl aanhactanae rick crn iat: MSRC$:FORSIGNAL/UPDATE=(ENH$:FORSIGNAL 


Size: 509 code + 0 data bytes 
Run Time: 00:15.6 

Elapsed Time: 00:39.4 

Lines/CPU Min: 2772 


Lexemes/CPU-Min: 16368 
neo 4 Used: 144 pages 
Compilation Complete 


x 
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